home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / program / qbprog.EXE / PCOPY.BAS < prev    next >
BASIC Source File  |  1995-10-15  |  3KB  |  126 lines
  1. DECLARE SUB arkaplan ()
  2. DECLARE SUB kutu (x%, y%, xx%, yy%, o%, f%)
  3. DECLARE SUB animasyon ()
  4. DECLARE SUB Show (x%, y%)
  5. DECLARE FUNCTION Tus% ()
  6. DECLARE FUNCTION ekranseg% ()
  7. DEFINT A-Z
  8. DIM SHARED MenuX, MenuY
  9. VIEW PRINT 1 TO 25
  10.     
  11.  
  12.        
  13.         CLS
  14.         animasyon
  15.         DO
  16.                 IF Tus THEN EXIT DO
  17.         LOOP
  18.         END
  19.  
  20. SUB animasyon
  21.         arkaplan
  22.         FOR menu = 1 TO 10
  23.                 Show menu, menu
  24.         FOR A! = 1 TO 500: NEXT
  25.         NEXT
  26.         MenuX = menu
  27.         MenuY = menu
  28.         Show MenuX, MenuY
  29. END SUB
  30.  
  31. SUB arkaplan
  32.         SCREEN , , 3, 0
  33.         COLOR 9, 7
  34.         CLS
  35.         A$ = "Programlama Sanatì...Sürükle bìrak..."
  36.         A = LEN(A$)
  37.         FOR I = 0 TO 1840 / A
  38.                 B = 80 - C
  39.                 IF B <= A THEN
  40.                         PRINT LEFT$(A$, B);
  41.                         PRINT RIGHT$(A$, A - B);
  42.                         C = A - B: D = C
  43.                 ELSE
  44.                         PRINT A$;
  45.                         C = C + A
  46.                 END IF
  47.         NEXT
  48.         DEF SEG = ekranseg + 256 * 3
  49.                 FOR I = 3680 + D * 2 TO 4000 STEP A * 2
  50.                 FOR y = 1 TO A
  51.                         POKE I + (y - 1) * 2, ASC(MID$(A$, y, 1))
  52.                 NEXT
  53.         NEXT
  54.         SCREEN , , 0
  55.         DEF SEG
  56. END SUB
  57.  
  58. FUNCTION ekranseg
  59. DEF SEG = 0
  60. IF PEEK(&H449) = 7 THEN
  61.         ekranseg = &HB000
  62. ELSE
  63.         ekranseg = &HB800
  64. END IF
  65. DEF SEG
  66. END FUNCTION
  67.  
  68. SUB kutu (x, y, xx, yy, o, f)
  69.         COLOR o, f
  70.         q1$ = "╔" + STRING$((xx - x) - 1, "═") + "╗"
  71.         q2$ = "╚" + STRING$((xx - x) - 1, "═") + "╝"
  72.         q3$ = "║" + STRING$((xx - x) - 1, " ") + "║"
  73.         LOCATE y, x: PRINT q1$;
  74.         LOCATE yy, x: PRINT q2$;
  75.         FOR I = y + 1 TO yy - 1
  76.                 LOCATE I, x: PRINT q3$;
  77.         NEXT
  78.         DEF SEG = ekranseg
  79.         FOR I = x TO xx
  80.                 POKE ((yy) * 160 + (I) * 2 + 1), 8
  81.         NEXT
  82.         FOR I = y TO yy
  83.                 TR = ((I) * 160 + (xx) * 2 + 1)
  84.                 POKE TR, 8
  85.         NEXT
  86.         DEF SEG
  87. END SUB
  88.  
  89. SUB Show (x, y)
  90.         menuAd$ = "[ Gezer Menu ]"
  91.         bilgi$ = "Cursor tuƒlarìna basìnìz"
  92.                 PCOPY 3, 0
  93.                 kutu x, y, x + 30, y + 6, 1, 3
  94.                 COLOR 15, 3
  95.                 FOR Secim = 1 TO 5
  96.                         LOCATE y + Secim, x + 1
  97.                         PRINT "Burasì;"; Secim; " Numaralì Seçiminiz"
  98.                 NEXT
  99.         COLOR 1, 3
  100.         LOCATE y, x + 8: PRINT menuAd$
  101.         LOCATE y + 6, x + 3: PRINT bilgi$
  102.  
  103. END SUB
  104.  
  105. FUNCTION Tus
  106. S = 0
  107.         A$ = INKEY$
  108.         IF A$ = "" THEN EXIT FUNCTION
  109.         IF ASC(A$) = 27 THEN Tus = 1: EXIT FUNCTION
  110.         IF LEN(A$) = 2 THEN
  111.                 Z = ASC(RIGHT$(A$, 1))
  112.                 SELECT CASE Z
  113.                         CASE 72: IF MenuY > 2 THEN MenuY = MenuY - 2: S = 1
  114.                         CASE 80: IF MenuY < 17 THEN MenuY = MenuY + 2: S = 1
  115.                         CASE 75: IF MenuX > 2 THEN MenuX = MenuX - 5: S = 1
  116.                         CASE 77: IF MenuX < 46 THEN MenuX = MenuX + 5: S = 1
  117.                         CASE 79: MenuX = 46: S = 1
  118.                                  MenuY = 17
  119.                         CASE 71: MenuY = 2: S = 1
  120.                                  MenuX = 2
  121.                 END SELECT
  122.                 IF S THEN Show MenuX, MenuY
  123.         END IF
  124. END FUNCTION
  125.  
  126.